perm filename FILLN.NL2[RST,LCS] blob sn#231772 filedate 1976-08-15 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE FILLER(QQ,MD)
C00005 ENDMK
CāŠ—;
	SUBROUTINE FILLER(QQ,MD)
	COMMON /RINP/I(900)
	DIMENSION H(350),Q(600)
	EQUIVALENCE (Q,I)
	KNT=I(3)
	RL=Q(1)
	RR=RL
	DO 1 K=1,KNT,3
CC	Q(K)=IFIX(Q(K))
CC	Q(K+1)=IFIX(Q(K+1))

	A=Q(K)
	IF(RL.GT.A)RL=A
1	IF(RR.LT.A)RR=A
C GET LEFT AND RIGHT EXTREME LIMITS.
	
	RR=RR-.5
	RL=RL-.5
2	RL=RL+1
C SLICE COUNTER
	M=0
	DO 3 J=4,KNT,3
	IF(I(J+2).EQ.3)GO TO 3
	IF(HORZ(I,J,RL))GO TO 3
C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
	M=M+1
	H(M)=HGT(J,RL,I)
3	CONTINUE
5	NN=0
	DO 4 J=1,M-1
	IF(H(J).GE.H(J+1))GO TO 4
C SORT HEIGHTS
	CALL EXCH(H(J),H(J+1))
	NN=-1
4	CONTINUE
	IF(NN)GO TO 5
C GO BACK IF MORE SORTING TO BE DONE
	NN=1
6	IF(H(NN).EQ.H(NN+1))GO TO 7
	A=H(NN)
	B=H(NN+1)
	CALL LINX(RL,A,RL,B)
7	NN=NN+2
C SKIP BY 2'S
	IF(NN.LT.M)GO TO 6
	IF(RL.LT.RR)GO TO 2
	END
	
	FUNCTION HGT(J,RL,Q)
	DIMENSION Q(1)
	HT=Q(J-2)
C  PREVIOUS Y COORD.
	A=Q(J-3)
C  PREVIOUS X COORD.
	B=Q(J+1)-HT
	C=RL-A
	D=Q(J)-A
CC	HGT=((I(J+1)-HGT)*(L-K))/(I(J)-K)+HGT
1	HGT=(B*C)/D+HT
CAN HAVE A DIVIDE BY ZERO HERE!!
	END
	
	FUNCTION HORZ(Q,J,RL)
C  L=VERT. SLICE
	DIMENSION Q(1)
	HORZ=0
	A=Q(J)
	B=Q(J-3)
C PREVIOUS X COORD.
	IF(A.EQ.B)GO TO 1
	IF(A.GT.B)CALL EXCH(A,B)
	IF(RL.LE.B.AND.RL.GE.A)RETURN
1	HORZ=-1
	END